home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Delphi Developer's Kit 1996
/
Delphi Developer's Kit 1996.iso
/
power
/
wordapi
/
capilib.pas
next >
Wrap
Pascal/Delphi Source File
|
1995-12-22
|
19KB
|
621 lines
{$N+}
{$DEFINE USE_SENDMESSAGE} { change the "$" to a "-" if you
don't want to use SendMessage()
(ONLY if you're compiling a .WLL!) }
UNIT CAPILib;
{ Library routines to support the Word's API
translated from "C" to BPascal by M.Austermeier 100116.3455@compuserve.com
req. Borland Pascal 7.x or Delphi 1.x to compile
History:
v1.1 30.09.95
* corrected bug in Register() function that lead to Word error 5007
* integrated some Word high level functions (CAPIAddXXX) provided by
Gregory M. Sohl 75144,2600 - thanks ;-)
* made ExecuteCommand a TWordCommand method
* made TWordDlgCommand safer (s. Abstract)
* some changes in demo
"These materials were developed from a Product of Microsoft Corporation,
which reserves all rights. They have been modified by Martin Austermeier"
See also the disclaimer in README.TXT
}
INTERFACE
USES
WdCmds, WdFid;
CONST
T_NONE = 0; { TypeXXX }
T_SHORT = 1;
T_LONG = 2;
T_DOUBLE = 3;
T_STRING = 4;
CONST
MAX_ARGS = 34; { MaxArgs based on largest dialog }
TYPE
TFType = Integer; { s. T_xxx }
TYPE
TArrayDef = RECORD
cArrayDimensions : Integer;
arrayDimensions : Array[0..0] OF Byte;
END;
PArrayDef = ^TArrayDef;
AFlag = (T0, T1, T2, T3, DataIsArray, DlgSetData, DlgGetData, bufferTooSmall);
TFlags = SET OF AFlag;
PDoubleArray = Pointer;
PStringArray = ^PChar;
TOperator = RECORD { WDOPR }
dat : RECORD CASE Integer OF
0 : (vShort : Integer);
1 : (vLong : LongInt);
2 : (vDouble : Double);
3 : (vString : PChar);
4 : (Arr : PArrayDef;
ptr : RECORD CASE Boolean OF
FALSE : (DoubleArray : PDoubleArray);
TRUE : (StringArray : PStringArray);
END;
);
END;
bufferSize : Word;
ft : RECORD CASE Boolean OF
FALSE : (flags : TFlags); { type & flags }
TRUE : (typ : TFType); { 2 bytes }
END;
{ resvd : Byte; }
fldID : Word;
END;
POperator = ^TOperator;
TYPE
{ Input and output constants for dialog commands }
AnIOMode = (DLG_GET_DATA, DLG_SET_DATA);
TIOMode = SET OF AnIOMode;
TYPE { DlgOption }
ADlgOption = (CMD_DEFAULTS, { GetCurValues }
CMD_DIALOG, { display dialog }
CMD_ACTION, { execute dialog }
CMD_DLG_ACTION); { display & exec }
TYPE
TControlBlock = RECORD
cmdID : Integer; { *new: command ID }
retBuf : Pointer; { *new* for automatic function return }
retBufSize : Word; { *new* for automatic function return }
dlgIOMode : TIOMode; { *new }
dlgOpts : ADlgOption; { *new }
argsCount : Integer; { cArgs (=index in args array) }
returnOp : TOperator; { wdopReturn }
args : Array[0..MAX_ARGS-1] OF TOperator; { wdoprArgs[MaxArgs] }
END;
PControlBlock = ^TControlBlock;
TYPE
TWordCommand = OBJECT
wcb : TControlBlock;
{----------------------------------}
CONSTRUCTOR Init(commandID : Integer;
retType : TFType;
retBuf : PChar;
retBufSize : Word);
{ commandID: see WDCMDS.PAS;
retType : type of function return;
retBuf : (only if retType <> T_NONE) pointer to a buffer where
RETURNed values are to be stored (max Len=retBufSize)
}
{----------------------------------}
DESTRUCTOR Done;
{----------------------------------}
PROCEDURE AddShortParam(shortVal : Integer); VIRTUAL;
{----------------------------------}
PROCEDURE AddLongParam(longVal : LongInt); VIRTUAL;
{----------------------------------}
PROCEDURE AddDoubleParam(doubleVal : Double); VIRTUAL;
{----------------------------------}
PROCEDURE AddStringParam(strP : PChar); VIRTUAL;
{----------------------------------}
FUNCTION Execute : Integer;
{ call wdCommandDispatch;
returns 0 if OK, else wdError.xx }
{----------------------------------}
FUNCTION ExecuteCommand : Boolean;
{ Execute; display error message if failed }
{----------------------------------}
PRIVATE
PROCEDURE _GetResult;
{ copies function result into buffer^, if available }
{----------------------------------}
END;
PWordCommand = ^TWordCommand;
TWordDlgCommand = OBJECT(TWordCommand)
{----------------------------------}
CONSTRUCTOR Init(commandID : Integer;
retType : TFType;
retBuf : PChar;
retBufSize : Word;
dialogOption : ADlgOption;
fMode : TIOMode);
{----------------------------------}
PROCEDURE AddShortDlgField(fieldId : Word; shortVal : Integer);
{----------------------------------}
PROCEDURE AddLongDlgField(fieldId : Word; longVal : LongInt);
{----------------------------------}
PROCEDURE AddDoubleDlgField(fieldId : Word; doubleVal : Double);
{----------------------------------}
PROCEDURE AddStringDlgField(fieldId : Word; strP : PChar; bufSize : Word);
{----------------------------------}
PRIVATE
{----------------------------------}
PROCEDURE _SetDlgField(fieldId : Word; fType : TFType);
{----------------------------------}
{ Abstract - not to be called! }
PROCEDURE AddShortParam(shortVal : Integer); VIRTUAL;
{----------------------------------}
PROCEDURE AddLongParam(longVal : LongInt); VIRTUAL;
{----------------------------------}
PROCEDURE AddDoubleParam(doubleVal : Double); VIRTUAL;
{----------------------------------}
PROCEDURE AddStringParam(strP : PChar); VIRTUAL;
{----------------------------------}
END;
PWordDlgCommand = ^TWordDlgCommand;
TWordArrayCommand = OBJECT(TWordCommand)
{ AddStringArray; AddDoubleArray NOT IMPLEMENTED! }
END;
PWordArrayCommand = ^TWordArrayCommand;
{-------------------------------------------------------------------}
FUNCTION Register(docID : Integer; functionName, description : PChar) : Word;
{ Register new command with Word }
{-------------------------------------------------------------------}
FUNCTION AddToolBar(docID: Integer; lpszToolbar: PChar): Boolean;
{docID:0,1,or wll.docID; lpszToolbar:Name of ToolBar }
{-------------------------------------------------------------------}
FUNCTION AddButton(docID: Integer; { (0, 1, or wll.docID) }
lpszToolBar: Pchar; { Name of ToolBar }
cPosition: Integer; { position to insert Button }
lpszMacro: Pchar; { Command to assotiate with Button }
lpszFace: Pchar): Boolean; { Face of the Button (Text Only) }
{-------------------------------------------------------------------}
FUNCTION AddMenu(docID: Integer;
menuName: PChar;
position: Integer;
menuType: Integer): Boolean;
{-------------------------------------------------------------------}
FUNCTION AddMenuItem(docID: Integer;
menuName: PChar;
menuCommand: PChar;
menuItemText: PChar;
position: Integer;
menuType: Integer): Boolean;
{-------------------------------------------------------------------}
FUNCTION AddKey(docID: Integer; keyCode: Integer; menuCommand: PChar): Boolean;
{-------------------------------------------------------------------}
IMPLEMENTATION
USES
WinTypes, WinProcs;
VAR
hWordWnd : HWnd;
(****************************************************************************
utility functions
****************************************************************************)
PROCEDURE ErrorBox(err : Integer; cmdID : Integer);
VAR
s : Array[0..50] OF Char;
args : Array [1..2] of Word;
BEGIN
args[1] := err;
args[2] := cmdId;
wvsprintf(s, 'Error #%d (cmdID=%d)', args);
MessageBox(0, s, 'CAPILIB', MB_OK);
END;
PROCEDURE Abstract; BEGIN RunError(211); END;
(****************************************************************************
TWordCommand
****************************************************************************)
CONSTRUCTOR TWordCommand.Init(commandID : Integer;
retType : TFType;
retBuf : PChar;
retBufSize : Word);
BEGIN
FillChar(wcb, SizeOf(wcb), 0);
wcb.cmdID := commandID;
wcb.returnOp.ft.typ := retType;
wcb.retBuf := retBuf;
wcb.retBufSize := retBufSize;
IF (retType = T_STRING) THEN WITH wcb.returnOp DO BEGIN
dat.vString := retBuf;
bufferSize := retBufSize;
END;
END;
DESTRUCTOR TWordCommand.Done;
BEGIN { remove VMT } END;
PROCEDURE TWordCommand.AddShortParam(shortVal : Integer);
BEGIN
WITH wcb.args[wcb.argsCount] DO BEGIN
dat.vShort := shortVal;
ft.typ := T_SHORT;
END;
Inc(wcb.argsCount);
END;
PROCEDURE TWordCommand.AddLongParam(longVal : LongInt);
BEGIN
WITH wcb.args[wcb.argsCount] DO BEGIN
dat.vLong := longVal;
ft.typ := T_LONG;
END;
Inc(wcb.argsCount);
END;
PROCEDURE TWordCommand.AddDoubleParam(doubleVal : Double);
BEGIN
WITH wcb.args[wcb.argsCount] DO BEGIN
dat.vDouble := doubleVal;
ft.typ := T_DOUBLE;
END;
Inc(wcb.argsCount);
END;
PROCEDURE TWordCommand.AddStringParam(strP : PChar);
BEGIN
WITH wcb.args[wcb.argsCount] DO BEGIN
dat.vString := strP;
ft.typ := T_STRING;
END;
Inc(wcb.argsCount);
END;
{ AddStringArray; AddDoubleArray NOT IMPLEMENTED! }
PROCEDURE TWordCommand._GetResult;
BEGIN
WITH wcb DO BEGIN
IF (returnOp.ft.typ = T_NONE) { no function result }
OR (returnOp.ft.typ = T_STRING) { unnecessary with T_STRING }
OR (retBuf = NIL) { no return buffer provided }
THEN
Exit;
Move (returnOp.dat, retBuf^, retBufSize); { copy result to buffer }
END;
END;
{$IFNDEF USE_SENDMESSAGE *********************************************}
FUNCTION WdCommandDispatch(commandId,
dlgOptions,
cArgs : Integer;
operators : POperator;
ret : POperator) : Integer;
FAR; EXTERNAL 'WINWORD';
FUNCTION TWordCommand.Execute : Integer;
VAR
retP : POperator;
ret : Integer;
BEGIN
WITH wcb DO BEGIN
IF (returnOp.ft.typ <> T_NONE) THEN
retP := @returnOp
ELSE
retP := NIL;
ret :=
WdCommandDispatch(cmdId,
Integer(dlgOpts),
argsCount,
@args,
retP);
IF (ret = 0) THEN
_GetResult;
Execute := ret;
END;
END;
{$ELSE (USE_SENDMESSAGE; Word is to be called from .EXE via Sendmessage()) *** }
FUNCTION TWordCommand.Execute : Integer;
{ call wdCommandDispatch via SendMessage
(takes the same time; avoids stack problems when called
from your .EXE instead of a .WLL);
returns 0 if OK, else wdError.xx }
CONST
WM_USER = $0400;
WM_WORD_CAPI = WM_USER + $0300;
WINWORD_CLASS = 'OpusApp';
VAR
msg : RECORD
cmdID : Integer;
dlgOpts : Integer;
cArgs : Integer;
lpwdoprArgs,
lpwdoprReturn : PControlBlock;
END;
ret : Integer;
BEGIN
{ get hWordWnd }
IF NOT IsWindow(hWordWnd) THEN
hWordWnd := FindWindow(WINWORD_CLASS, NIL);
IF (hWordWnd = 0) THEN BEGIN
ret := 5031; { wdError.errCAPICommandFailed }
END ELSE WITH wcb DO BEGIN
msg.cmdID := cmdId;
msg.dlgOpts := Integer(dlgOpts);
msg.cArgs := argsCount;
msg.lpwdoprArgs := @args;
IF (returnOp.ft.typ <> T_NONE) THEN
msg.lpwdoprReturn := @returnOp
ELSE
msg.lpwdoprReturn := NIL;
ret := SendMessage(hWordWnd, WM_WORD_CAPI, 0, LongInt(@msg));
IF (ret = 0) THEN
_GetResult;
END;
Execute := ret;
END;
{$ENDIF USE_SENDMESSAGE **************************************************}
FUNCTION TWordCommand.ExecuteCommand : Boolean;
VAR
i : Integer;
BEGIN
i := Execute; { Execute the command }
IF (i <> 0) THEN
ErrorBox(i, wcb.cmdId); { display error }
ExecuteCommand := (i = 0);
END;
(*************************************************************************
TWordDlgCommand
*************************************************************************)
CONSTRUCTOR TWordDlgCommand.Init(commandID : Integer;
retType : TFType;
retBuf : PChar;
retBufSize : Word;
dialogOption : ADlgOption;
fMode : TIOMode);
BEGIN
INHERITED Init(commandID, retType, retBuf, retBufSize);
wcb.dlgOpts := dialogOption;
wcb.dlgIOMode := fMode;
END;
PROCEDURE TWordDlgCommand.AddShortParam(shortVal : Integer);
BEGIN Abstract; END; { not valid with dialog commands! }
PROCEDURE TWordDlgCommand.AddLongParam(longVal : LongInt);
BEGIN Abstract; END; { not valid with dialog commands! }
PROCEDURE TWordDlgCommand.AddDoubleParam(doubleVal : Double);
BEGIN Abstract; END; { not valid with dialog commands! }
PROCEDURE TWordDlgCommand.AddStringParam(strP : PChar);
BEGIN Abstract; END; { not valid with dialog commands! }
PROCEDURE TWordDlgCommand._SetDlgField(fieldId : Word; fType : TFType);
BEGIN
WITH wcb.args[wcb.argsCount] DO BEGIN
ft.typ := fType;
fldId := fieldId;
IF (DLG_GET_DATA IN wcb.dlgIOMode) THEN
Include(ft.flags, DlgGetData);
IF (DLG_SET_DATA IN wcb.dlgIOMode) THEN
Include(ft.flags, DlgSetData);
END;
END;
PROCEDURE TWordDlgCommand.AddShortDlgField(fieldId : Word; shortVal : Integer);
BEGIN
wcb.args[wcb.argsCount].dat.vShort := shortVal;
_SetDlgField(fieldId, T_SHORT);
Inc(wcb.argsCount);
END;
PROCEDURE TWordDlgCommand.AddLongDlgField(fieldId : Word; longVal : LongInt);
BEGIN
wcb.args[wcb.argsCount].dat.vLong := longVal;
_SetDlgField(fieldId, T_LONG);
Inc(wcb.argsCount);
END;
PROCEDURE TWordDlgCommand.AddDoubleDlgField(fieldId : Word; doubleVal : Double);
BEGIN
wcb.args[wcb.argsCount].dat.vDouble := doubleVal;
_SetDlgField(fieldId, T_DOUBLE);
Inc(wcb.argsCount);
END;
PROCEDURE TWordDlgCommand.AddStringDlgField(fieldId : Word; strP : PChar; bufSize : Word);
BEGIN
wcb.args[wcb.argsCount].dat.vString := strP;
_SetDlgField(fieldId, T_STRING);
wcb.args[wcb.argsCount].bufferSize := bufSize;
Inc(wcb.argsCount);
END;
(*************************************************************************
High Level Word Functions
*************************************************************************)
FUNCTION Register(docID : Integer; functionName, description : PChar) : Word;
VAR
wcmd : TWordCommand;
BEGIN
wcmd.Init(wdAddCommand, T_NONE, NIL, 0);
wcmd.AddShortParam(docID);
wcmd.AddStringParam(functionName);
IF (Assigned(description)) THEN
wcmd.AddStringParam(description);
Register := wcmd.Execute;
wcmd.Done;
END;
{ Implemented 09/1995 }
{ ******* CAPIAdd ToolBar ******* }
FUNCTION AddToolBar(docID: Integer; lpszToolbar: PChar): Boolean;
VAR
wcmd: TWordDlgCommand;
BEGIN
wcmd.Init(wdNewToolbar, T_NONE, NIL, 0, CMD_ACTION, [DLG_SET_DATA]);
wcmd.AddStringDlgField(fidName, lpszToolBar, 0); {Name of ToolBar}
wcmd.AddShortDlgField(fidContext, docID); {(0, 1, or docID)}
AddToolBar := wcmd.ExecuteCommand;
wcmd.Done;
END;
{ ********** CAPIAddButton ******** }
FUNCTION AddButton(docID: Integer; lpszToolBar: Pchar; cPosition: Integer; lpszMacro: Pchar; lpszFace: Pchar): Boolean;
VAR
wcmd: TWordCommand;
BEGIN
wcmd.Init(wdAddButton, T_NONE, NIL, 0);
wcmd.AddStringParam(lpszToolBar); {Name of ToolBar}
wcmd.AddShortParam(cPosition); {position to insert Button}
wcmd.AddShortParam(1);
wcmd.AddStringParam(lpszMacro); {Command to assotiate with Button}
wcmd.AddStringParam(lpszFace); {Face of the Button (Text Only)}
wcmd.AddShortParam(docID); {(0, 1, or docID)}
AddButton := wcmd.ExecuteCommand;
wcmd.Done;
END;
{ ********** CAPIAddMenu ********* }
FUNCTION AddMenu(docID: Integer;
menuName: PChar;
position: Integer;
menuType: Integer): Boolean;
VAR
wcmd: TWordDlgCommand;
BEGIN
wcmd.Init(wdToolsCustomizeMenuBar, T_NONE, NIL, 0, CMD_ACTION, [DLG_SET_DATA]);
wcmd.AddStringDlgField(fidMenuText, menuName,0); {Name of Menu}
wcmd.AddShortDlgField(fidPosition, position); {position of new Menu}
wcmd.AddShortDlgField(fidAdd, 1);
wcmd.AddShortDlgField(fidMenuType, menuType); {Type of Menu}
wcmd.AddShortDlgField(fidContext, docID);
AddMenu := wcmd.ExecuteCommand;
wcmd.Done;
END;
{ ********** CAPIAddMenuItem ********* }
FUNCTION AddMenuItem(docID: Integer;
menuName: PChar;
menuCommand: PChar;
menuItemText: PChar;
position: Integer;
menuType: Integer): Boolean;
VAR
wcmd: TWordDlgCommand;
BEGIN
wcmd.Init(wdToolsCustomizeMenus, T_NONE, NIL, 0, CMD_ACTION, [DLG_SET_DATA]);
wcmd.AddShortDlgField(fidContext, docID); { (0, 1, or docID)}
wcmd.AddStringDlgField(fidMenu, menuName, 0); {Name of menu}
wcmd.AddStringDlgField(fidName, menuCommand, 0); {Command to Add}
wcmd.AddStringDlgField(fidMenuText, menuItemText,0); {Menu Item text}
wcmd.AddShortDlgField(fidPosition, position); {position in Menu}
wcmd.AddShortDlgField(fidMenuType, menuType); {Type of the Menu}
wcmd.AddShortDlgField(fidCategory, 1);
wcmd.AddShortDlgField(fidAdd, 1);
AddMenuItem := wcmd.ExecuteCommand;
wcmd.Done;
END;
{ ********** CAPIAddKey ********* }
FUNCTION AddKey(docID: Integer; keyCode: Integer; menuCommand: PChar): Boolean;
VAR
wcmd: TWordDlgCommand;
BEGIN
wcmd.Init(wdToolsCustomizeKeyboard, T_NONE, NIL, 0, CMD_ACTION, [DLG_SET_DATA]);
wcmd.AddShortDlgField(fidKeyCode, keyCode); { Key Combo to be set}
wcmd.AddShortDlgField(fidCategory, 1);
wcmd.AddStringDlgField(fidName, menuCommand, 0); {Command to Assign to Key}
wcmd.AddShortDlgField(fidAdd, 1);
wcmd.AddShortDlgField(fidContext, docID); { (0, 1, or docID)}
AddKey := wcmd.ExecuteCommand;
wcmd.Done;
END;
(************************************************************************
Unit Init
************************************************************************)
BEGIN
hWordWnd := 0;
END.